home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / System / Bond FBA / Bond FBA.p < prev    next >
Text File  |  1996-05-04  |  2KB  |  88 lines
  1. {$I-}
  2. program FBATest;
  3.     uses
  4.         AppleEvents, CheapSound;
  5.  
  6.     var
  7.         gDone: Boolean;
  8.         gMyErr: OSErr;
  9.         startTime: Longint;
  10.  
  11.     function MyGotRequiredParams (theAppleEvent: AppleEvent): OSErr;
  12.         var
  13.             myErr: OSErr;
  14.             returnedType: DescType;
  15.             actualSize: Size;
  16.     begin
  17.         myErr := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType, nil, 0, actualSize);
  18.         if myErr = errAEDescNotFound then
  19.             MyGotRequiredParams := noErr
  20.         else if myErr = noErr then
  21.             MyGotRequiredParams := errAEParamMissed;
  22.     end;    {MyGotRequiredParams}
  23.  
  24.     function MyHandleQuiteEvent (theAppleEvent, reply: AppleEvent;
  25.                                     handlerRefcon: LongInt): OSErr;
  26.     begin
  27.         gMyErr := MyGotRequiredParams(theAppleEvent);
  28. {if gMyErr = noErr then}
  29. {Quit regardless of errors.}
  30.         gDone := true;
  31.  
  32.         MyHandleQuiteEvent := gMyErr;
  33.     end;    {MyHandleQuiteEvent}
  34.  
  35.     function MyHandleOpenAppEvent (theAppleEvent, reply: AppleEvent;
  36.                                     handlerRefcon: LongInt): OSErr;
  37.     begin
  38.         gMyErr := MyGotRequiredParams(theAppleEvent);
  39.         if gMyErr = noErr then
  40.             begin
  41.             end;    {noErr}
  42.  
  43.         MyHandleOpenAppEvent := gMyErr;
  44.     end;    {MyHandleOpenAppEvent}
  45.  
  46.     procedure GetEvents;
  47.         var
  48.             theEvent: EventRecord;
  49.             gotOne: Boolean;
  50.             lastTime: LongInt;
  51.     begin
  52.         lastTime := TickCount;
  53.  
  54.         repeat
  55.             gotOne := WaitNextEvent(everyEvent, theEvent, 500, nil);
  56.             if gotOne then
  57.                 if theEvent.what = kHighLevelEvent then
  58.                     gMyErr := AEProcessAppleEvent(theEvent);
  59.  
  60.             if TickCount > lastTime + 120 then {At least 2 seconds from start}
  61.                 if not SoundPlaying then
  62.                     gDone := true;
  63.             if TickCount > lastTime + 7200 then {Never stay more than 2 minutes}
  64.                 gDone := true;
  65.  
  66.         until gDone;
  67.     end;    {GetEvents}
  68.  
  69.     const
  70.         kStackSize = (24 * 1024);  {Lets create a larger stack}
  71.  
  72.     function LMGetCurStackBase: Ptr;
  73.     inline
  74.         $2EB8, $0908;            { MOVE.l $0908,(SP) }
  75.  
  76. begin
  77.     InitGraf(@thePort);                                                                     { Init Quickdraw Globals}
  78.     SetApplLimit(Ptr(Ord(LMGetCurStackBase) - kStackSize));        { Set the Stack Size default is to small}
  79.     MaxApplZone;                                                                            { Expand the heap to its max}
  80.     MoreMasters;                                                                            { Create master block}
  81.  
  82.     gDone := false;
  83.     gMyErr := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @MyHandleOpenAppEvent, 0, false);
  84.     gMyErr := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @MyHandleQuiteEvent, 0, false);
  85.     PlayNamedSound('James Bond Theme');
  86.     startTime := TickCount;
  87.     GetEvents;
  88. end.    {FBATest}